MacFormat 1995 March/macformat-022.iso/Shareware City/Utilities/Cron ƒ/cron commons/argc Receiver.p

Text File | 1993-07-04 | 7.5 KB | 359 lines | [TEXT/PJMM]

unit argcReceiver;

interface

    type
        StringPtrArray = array[0..1000] of StringPtr;
        StringPtrArrayPtr = ^StringPtrArray;

    procedure argcReceiver (var argcRcvd: integer; var argvRcvd: StringPtrArrayPtr);
    function TrapAvailable (theTrap: integer): boolean;
    procedure MacInits;

{    ——————————————————————————————————————————————————————————————————}
{    }
{    Filename: "argc Receiver.c"}
{    argc/argv argument receiver code, written for THINK C 5.0}
{    By Chris Johnson}
{    Version of: Thursday, July 23, 1992}
{    }
{    Distribute freely and without charge, but say something nice about }
{    the author when you use it.  Please send me a copy of any improve-}
{    ments you make so they can be incorporated into future versions.}
{    }
{    ——————————————————————————————————————————————————————————————————}
{    Internet:    [e-mail]}
{    UUCP:        (husc6|uunet)!cs.utexas.edu!ut-emx!chrisj}
{    BitNet:        [e-mail]}
{    AppleLink:    [e-mail]@internet#}
{    CompuServe:    >INTERNET:[e-mail]}
{    US Mail:    Chris Johnson, 4505-B Avenue H, Austin, TX 78751}
{    —————————————————————————————————————————————————————————————————-}

implementation

    uses
        Traps, AppleEvents;

    const
        argcEventClass = 'args';
        argcEventID = 'argc';
        argcKeyword = 'argc';

    var
        WaitFlag: Boolean;
        argc: integer;
        argv: StringPtrArrayPtr;

    function NumToolboxTraps: integer;
    begin
        if NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) then begin
            NumToolboxTraps := $200;
        end
        else begin
            NumToolboxTraps := $400;
        end;
    end;

    function GetTrapType (theTrap: integer): TrapType;
        var
            tType: TrapType;
    begin

        if BAND(theTrap, $0800) <> 0 then begin
            GetTrapType := ToolTrap;
        end
        else begin
            GetTrapType := OSTrap;
        end;
    end;



    function TrapAvailable (theTrap: integer): Boolean;
        var
            tType: TrapType;
    begin

        tType := GetTrapType(theTrap);

        if tType = ToolTrap then begin

            theTrap := BAND(theTrap, $07FF);
            if theTrap >= NumToolboxTraps then begin
                theTrap := _Unimplemented;
            end;
        end;

        TrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress(_Unimplemented, ToolTrap);
    end;

    function MyGotRequiredParams (Event: AppleEvent): OSErr;
        var
            OSError: OSErr;
            ReturnedType: DescType;
            ActualSize: longInt;
    begin

        OSError := AEGetAttributePtr(Event, keyMissedKeywordAttr, typeWildCard, ReturnedType, nil, 0, ActualSize);
        if OSError = errAEDescNotFound then begin

            OSError := noErr;

        end
        else if OSError = noErr then begin
            OSError := errAEEventNotHandled;
        end;

        MyGotRequiredParams := OSError;
    end;


    function Quit (var RcvdEvent: AppleEvent; var ReplyEvent: AppleEvent; RefCon: longInt): OSErr;
        var
            OSError: OSErr;
    begin

        OSError := MyGotRequiredParams(RcvdEvent);
        if OSError = noErr then begin
            WaitFlag := FALSE;
        end;

        Quit := OSError;
    end;

    function ArgsGet (RcvdEvent: AppleEvent; ReplyEvent: AppleEvent; RefCon: longInt): OSErr;
        var
            OSError, junk: OSErr;
            ArgCList: AEDesc;
            ArgCount: longInt;
            Keyword: AEKeyword;
            ActualSize: longInt;
            CurArgV: integer;
            DataType: DescType;
            DataSize: longInt;
    begin
        OSError := AEGetParamDesc(RcvdEvent, argcKeyword, typeAEList, ArgCList);
        if OSError = noErr then begin

            OSError := AECountItems(ArgCList, ArgCount);
            if OSError = noErr then begin

                argc := ArgCount;
                argv := StringPtrArrayPtr(NewPtrClear(sizeof(Ptr) * (ArgCount + 1)));

                OSError := MemError;
                if OSError = noErr then begin

                    for CurArgV := 0 to ArgCount - 1 do begin

                        OSError := AESizeOfNthItem(ArgCList, CurArgV + 1, DataType, DataSize);
                        if OSError = noErr then begin

                            argv^[CurArgV] := StringPtr(NewPtr(DataSize + 1));
                            OSError := MemError;
                            if OSError = noErr then begin

{$PUSH}
 {$R-}
                                OSError := AEGetNthPtr(ArgCList, CurArgV + 1, typeChar, Keyword, DataType, @argv^[CurArgV]^[1], DataSize, ActualSize);
                                if OSError = noErr then begin
                                    argv^[CurArgV]^[0] := chr(DataSize);
{$POP}
                                end;
                            end;
                        end;
                        if OSError <> noErr then
                            leave;
                    end;

                end;
            end;

            junk := AEDisposeDesc(ArgCList);
        end;

        if OSError = noErr then begin
            OSError := MyGotRequiredParams(RcvdEvent);
        end;

        if OSError <> noErr then begin

            argc := 0;
            argv := nil;
        end;

        WaitFlag := FALSE;

        ArgsGet := OSError;
    end;

    procedure ArgsDispose;
        var
            CurArg: integer;
    begin
        if argv <> nil then begin

            for CurArg := 0 to argc - 1 do begin

                if argv^[CurArg] <> nil then begin
                    DisposPtr(Ptr(argv^[CurArg]));
                end;
            end;

            DisposPtr(Ptr(argv));
        end;

        argc := 0;
        argv := nil;
    end;


    function EnvironmentCheck: boolean;
        var
            Continue: boolean;
            Response: longInt;
    begin
        Continue := FALSE;

        if TrapAvailable(_WaitNextEvent) then begin

            if TrapAvailable(_GestaltDispatch) then begin

                if Gestalt(gestaltAppleEventsAttr, Response) = noErr then begin

                    if BTST(Response, gestaltAppleEventsPresent) then begin

                        if AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @Quit, 0, FALSE) = noErr then begin

                            if AEInstallEventHandler(argcEventClass, argcEventID, @ArgsGet, 0, FALSE) = noErr then begin

                                WaitFlag := TRUE;
                                Continue := TRUE;
                            end;
                        end;
                    end;
                end;
            end;
        end;

        EnvironmentCheck := Continue;
    end;


{    ——————————————————————————————————————————————————————————  }
{    All of the following code comes from IM VI pg. 3-8. }
{    ——————————————————————————————————————————————————————————    }



{    ——————————————————————————————————————————————————————————  }
{    Code to determine what sort of toolbox initializations we   }
{    need to perform. }
{    ——————————————————————————————————————————————————————————    }

    const
        BackgroundOnlyMask = $0400;

    function BackgroundOnlyApp: boolean;
        type
            intPtr = ^integer;
            intHandle = ^intPtr;
        var
            BackgroundOnly: Boolean;
            SizeHand: handle;
            Flags: integer;
    begin
        BackgroundOnly := FALSE;

        SizeHand := Get1Resource('SIZE', -1);
        if SizeHand <> nil then begin

            LoadResource(SizeHand);
            if ResError = noErr then begin

                Flags := intHandle(SizeHand)^^;

                if BAND(Flags, BackgroundOnlyMask) <> 0 then begin

                    BackgroundOnly := TRUE;
                end;
            end;

            ReleaseResource(SizeHand);
        end;

        BackgroundOnlyApp := BackgroundOnly;
    end;

    procedure MacInits;
    begin

        InitGraf(@thePort);
        if BackgroundOnlyApp = FALSE then begin

            InitFonts;
            InitWindows;
            InitMenus;
            TEInit;
            InitDialogs(nil);
            InitCursor;
        end;
    end;

    procedure argcReceiver (var argcRcvd: integer; var argvRcvd: StringPtrArrayPtr);
        var
            TimeoutTicks: longInt;
            Event: EventRecord;
            junk: OSErr;
    begin

        ArgsDispose;
        if EnvironmentCheck then begin

            TimeoutTicks := TickCount + 60 * 60;

            while WaitFlag do begin

                if WaitNextEvent(everyEvent, Event, 60, nil) then begin

                    case Event.what of

                        keyDown:  begin

                            if BAND(Event.modifiers, cmdKey) <> 0 then begin

                                if chr(BAND(Event.message, $FF)) = 'q' then begin
                                    WaitFlag := FALSE;
                                end;
                            end;
                        end;

                        kHighLevelEvent:  begin
                            junk := AEProcessAppleEvent(Event);
                        end;
                    end; { case }
                end; { if }

        {    If we're still waiting and we've been waiting more than  }
        {    a minute, it's time to quit. }

                if TickCount >= TimeoutTicks then begin
                    WaitFlag := FALSE;
                end;
            end;

            junk := AERemoveEventHandler(kCoreEventClass, kAEQuitApplication, @Quit, FALSE);
            junk := AERemoveEventHandler(argcEventClass, argcEventID, @ArgsGet, FALSE);
        end;

        if argv = nil then begin
            ExitToShell;
        end;

        argcRcvd := argc;
        argvRcvd := argv;
    end;


end.